perm filename DOER[AP,SYS]2 blob sn#013863 filedate 1972-11-27 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00016 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00003 00002	Definitions.
 00006 00003	Storage allocations.
 00011 00004	Start of main program (DOER).  Prepare to read in uncataloged story from 'NEWS' file.
 00016 00005	Read in undun story.  Check sequence nbr for digest, etc.
 00020 00006	For each word in story, collect its letters.
 00023 00007	Check current word for indicator of a correction, an add, or a take.
 00028 00008	Find appropriate place in sorted list for current word.
 00032 00009	Open INDEX and DICT files.  Read in WORDS and LINKS files.
 00034 00010	Look for keywords in story.  Link up any that are found.
 00037 00011	Link up keyword in story.
 00043 00012	Write out new versions of files.
 00048 00013	Subroutines:  RDDICT, GTDICT, PAUSE1-4, DIGEST, DONTDO, GONE.
 00053 00014	Subroutines: ERROR.
 00055 00015	Write error message on a file with the time, month, and day.
 00058 00016	Interrupt level module: INTRPT, CHGNAM.
 00060 ENDMK
⊗;
;Definitions.

	TITLE	DOER
;     ACCUMULATOR ASSIGNMENTS
A←1			;temporary AC
B←2			;temporary AC
C←3			;temporary AC
AVAIL←←3		;pointer to an available link block in LINKS
WD←4			;the word being looked at in the sorted list
PREV←←4
DICTWD←5		;pointer to the current dictionary entry
FIRST←6			;ptr to text of current dictionary word
AC1←←7			;temporary AC
AC2←←10			;temporary AC
SORPTR←7		;pointer to current entry in the sorted list (SORDID)
TXTPTR←10		;byte pointer for depositing letters into TEXT area
PART1←←11		;four ac's for holding the (possible) 4 words per
PART2←←12		;	entry in the sorted list. Used in comparison.
PART3←←13
PART4←←14
CHAR←11			;current character of story
DISPL←12
SIZE←13
BPTR←15			;byte pointer into buffer holding current story
LWD←16			;the last word looked at in the sorted list
P←17

LF←←12
CR←←15

NKEYS←←=20		;max nbr of keywords all starting with same word
PDLEN←←=30		;length of push down list

SPECS←←4		;number of special words at front of INDEX file
XSIZE←←3		;size of the index entry for one story
MAXNBR←←=500		;maximum number of stories allowed
XLEN←MAXNBR*XSIZE+SPECS	;total size of space for index entries
LLEN←←10000
WLEN←←6400

DEFINE UNDUN {INDEX}	;first word in INDEX file
DEFINE NEW {INDEX+1}	;second word
DEFINE OLD {INDEX+2}	;third word

;ERRMSG causes an error message to be added to the ERRORS file.  Then
;	the SWAP UUO is called to start up a fresh version of DOER.
DEFINE ERRMSG(MSG)
	{PUSHJ	P,[	SETZM	XITFLG
			MOVEM	A,SAVEDA
			MOVEI	A,[ASCIZ \ DOER:  MSG
\]
			JRST	ERROR]}

;ERRXIT causes an error message to be added to the ERRORS file.  Then
;	the program EXITs.
DEFINE ERRXIT(MSG)
	{PUSHJ	P,[	SETOM	XITFLG
			MOVEM	A,SAVEDA
			MOVEI	A,[ASCIZ \ DOER:  MSG
\]
			JRST	ERROR]}

EXTERNAL JOBAPR,JOBCNI
;Storage allocations.

NEWSF:	SIXBIT	/NEWS/	;block for LOOKUP and ENTER for NEWS file
	BLOCK	3
INDEXF:	SIXBIT	/INDEX/	;block for LOOKUP and ENTER for INDEX file
	BLOCK	3
LINKSF: SIXBIT	/LINKS/	;block for LOOKUP and ENTER for LINKS file
	BLOCK	3
DICTF:	SIXBIT	/DICT/	;block for LOOKUP and ENTER for DICT file
	BLOCK	3
WORDSF:	SIXBIT	/WORDS/	;block for LOOKUP for WORDS file
	BLOCK	3
ERRORF:	SIXBIT	/ERRORS/;block for LOOKUP and ENTER for ERRORS file
	BLOCK	3

STORY:	BLOCK	2200	;buffer to hold stories
INDEX:	BLOCK	XLEN	;core array for holding index pointers for stories
LINKS:	BLOCK	LLEN	;holds the assorted relationships for words found in DICT
DICT:	BLOCK	400	;holds two records of the dictionary, 1 reg and 1 mults
WORDS:	BLOCK	WLEN	;holds the words actually pointed to in DICT
SORDID:	BLOCK	=600	;holds the sorted list of words in a story
TEXT:	BLOCK	=1500	;holds the characters of the words in the story
PDLIST:	BLOCK	PDLEN	;push down list
KEYS:	BLOCK	NKEYS	;ptrs to dictionary entries for keywords categorizing story
ERRBFI:	BLOCK	3	;buffer header for input buffer for copying old error msgs
ERRBFO:	BLOCK	3	;buffer header for output buffer for writing out error msgs

CMD:	IOWD	1,STORY		;command for reading in a story to be cataloged
	0
XCMD:	IOWD	XLEN,INDEX	;command for reading/writing INDEX
	0
LCMD:	IOWD	LLEN,LINKS	;command for reading/writing LINKS
	0
DCMD:	IOWD	200,DICT	;command for reading/writing DICT
	0
MCMD:	IOWD	200,DICT+200	;command for reading/writing a mult rec of DICT
	0
WCMD:	IOWD	WLEN,WORDS	;command for reading WORDS
	0

DSK17:	17			;block for OPENing the DSK in mode 17 many times
	SIXBIT	/DSK/
	0
SWAPBK:	SIXBIT	/DSK/
	SIXBIT	/DOER/
	SIXBIT	/DMP/
	0
	SIXBIT	/ APSYS/

NAME:	SIXBIT	/[DOER]/	;name DOER uses while running
WRDCNT:	0
DICPTR:	0			;pointer to the current dictionary entry
DICREC:	0			;number of the current record of DICT that is in core
MLTPTR:	0			;negated ptr to DICT entry for current mult word key
MLTREC:	0			;number of the current mult rec of DICT that is in core
GUDREC:	0			;number of current mult rec that needs to be in core
WRFLAG:	0			;flag indicating whether the DICREC must be written out
LKOVFL:	0			;LINKS space overflow flag
LOSEQ:	0			;lowest acceptable seq nbr for earlier take
HISEQ:	0			;highest acceptable seq nbr for earlier take
SPBPTR:	0			;special byte ptr
MISSIN:	0			;flag indicating if story sought in NEWS was found
NRDOER:	0			;code indicating number of other DOERs
TTYLIN:	0			;word for indicating whether DOER is detached
SAVEDA:	0			;word for storing accumulator A upon an error
XITFLG:	0			;flag indicating whether DOER should exit after writing error file
TAKEFG:	0			;flag indicating whether current story is first of TAKES
STCNT:	0		;word for number of stories we have yet to look for earlier take
CATFLG:	0	;flag indicating whether current word has been used to categorize the story
LEN:	0			;pseudo length of a story word
CHCNT:	0			;character count for the UNDUN story
CATNBR:	0			;nbr of similar keywords categorizing story
;Start of main program (DOER).  Prepare to read in uncataloged story from 'NEWS' file.

DOER:	MOVEI	A,INTRPT	;get address of interrupt level module
	MOVEM	A,JOBAPR	;store it in JOBAPR
	MOVE	A,[400200000]	;enable for interrupts on parity errors and
	CALL	A,[SIXBIT /INTENB/];	pdl ov
	MOVEI	A,200000
	CALL	A,[SIXBIT /INTGEN/];generate a pdl ov interrupt to set the job name
	MOVE	A,NRDOER	;get code nbr indicating number of other DOERs
	JRST	.+2(A)
	ERRXIT	{ONE OTHER DOER ALREADY EXISTED WHEN DOER STARTED UP (0)}
	ERRXIT	{TWO OR MORE DOERS EXISTED WHEN DOER STARTED UP (1)}
	
AGAIN3:	OPEN	1,DSK17		;get the index file
	ERRXIT	{OPEN FAILED ON DSK (2)}
	SETZM	INDEXF+3
	LOOKUP	1,INDEXF	;INDEX file
	JRST	PAUSE3
	IN	1,XCMD		;read in INDEX file
	JRST	.+2
	ERRXIT	{IN UUO FAILED DURING ATTEMPT TO READ IN INDEX FILE (4)}
	RELEAS	1,		;INDEX file
	MOVE	P,[INITPD: IOWD PDLEN,PDLIST];init the stack ptr
	MOVE	B,UNDUN		;grab UNDUN from the INDEX file
MORE:	CAMN	B,NEW		;has UNDUN caught up with NEW?
	CALL	[SIXBIT /EXIT/]	;yes. exit (releasing the job since jlog is probably not set)
;check if UNDUN points to a story that has been deleted or otherwise wiped out
DOMORE:	MOVE	A,OLD		;get index of OLD story and compare with
	CAMG	A,NEW		;	index of NEW area
	JRST	OLDLES		;OLD index is above (less than) NEW index
	CAML	B,NEW		;NEW index is above (less than) OLD index.
	CAML	B,OLD		;is UNDUN between OLD and NEW?
	JRST	DOMOR1		;no.  everything is ok.
OLDUN:	MOVEM	A,UNDUN		;make the oldest story the first undun one
	MOVE	B,A
	JRST	DOMOR1
OLDLES:	CAML	B,OLD		;OLD index is above (less than) NEW index
	CAML	B,NEW		;is UNDUN between OLD and NEW?
	JRST	OLDUN		;no! UNDUN story seems to have been deleted (or something)
;calculate the size of the UNDUN story using its position and that of the next story
DOMOR1:	MOVE	SIZE,B
	ADDI	SIZE,XSIZE
	CAIL	SIZE,XLEN
	MOVEI	SIZE,SPECS
	MOVN	SIZE,INDEX+1(SIZE)
	ADD	SIZE,INDEX+1(B)
	JUMPL	SIZE,ONWARD
DOWN:	MOVN	SIZE,INDEX+3	;UNDUN story is last in NEWS. get ptr to end of NEWS
	ADD	SIZE,INDEX+1(B)
ONWARD:	ASH	SIZE,-13	;right adjust the negated size of the UNDUN story
	OUTSTR	[ASCIZ / STORY! /]
	HRRZ	DISPL,INDEX+1(B);get displacement of UNDUN story
	ASH	DISPL,-13	;right-adjust displacement
	MOVN	A,DISPL		;make displacement negative (size is already negative)
	ADD	A,SIZE		;calculate length of NEWS stuff to be read in
	HRLM	A,CMD		;put length in the command word
	SETZM	LINKS+1		;clear the back ptr to slots for this story
	SETZM	MISSIN		;clear flag that would indicate story was not found
	SETZM	TAKEFG		;clear flag that would indicate first of several takes
;Read in undun story.  Check sequence nbr for digest, etc.

AGAIN1:	OPEN	0,DSK17		;prepare to read the NEWS file
	ERRXIT	{OPEN FAILED ON DSK (6)}
	SETZM	NEWSF+3
	LOOKUP	0,NEWSF		;NEWS file
	JRST	PAUSE1		;can't read NEWS...FILER is writing it
	HLRZ	A,INDEX+1(B)	;get record number for UNDUN story
	USETI	0,(A)
	IN	0,CMD		;input the UNDUN story into STORY
	JRST	.+2
	ERRXIT	{IN UUO FAILED DURING ATTEMPT TO READ IN NEWS STORY (8)}
	RELEAS	0,		;NEWS file
	MOVEI	BPTR,STORY-1(DISPL)	;point byte pointer at first word of story
	HRLI	BPTR,700	;initialize byte pointer
	MOVE	TXTPTR,[POINT 7,TEXT-1,34]  ;initialize byte ptr to start of TEXT
	MOVE	A,SIZE		;put number of chars in story into CNT by
	ASH	A,2		;	multiplying size by 5
	ADD	A,SIZE
	MOVEM	A,CHCNT		;store number of chars
	MOVEI	SORPTR,1	;initialize SORPTR to start of SORDID
	MOVEI	B,3		;prepare to look for 3 digits of sequence nbr
	SETZ	C,
NXTDG:	ILDB	A,BPTR		;get a char from first word of story
	CAIG	A,"9"		;is it a digit?
	CAIGE	A,"0"
	JRST	GONE		;no!
	IMULI	C,=10		;yes.  multiply sum of previous digits by =10
	ADDI	C,-60(A)	;add in current digit
	SOJG	B,NXTDG		;got all 3 digits of seq nbr?
	ILDB	A,BPTR		;yes. get char after the 3 digits
	CAIE	A,CR		;does CR follow the digits?
	JRST	GONE		;no!
	ILDB	A,BPTR		;yes
	CAIE	A,LF		;does LF follow the CR?
	JRST	GONE		;no!
	MOVE	B,UNDUN
	HRRZ	A,INDEX+2(B)	;GET SUPPOSED SEQ NBR OF STORY
	CAME	C,A		;DOES STORY IN NEWS HAVE CORRECT SEQ NBR?
	JRST	GONE		;NO!
	MOVEM	C,HISEQ		;SAVE SEQ NBR OF CURRENT STORY
	CAIN	C,1		;is this the story just before the PMS digest?
	JRST	DONTDO		;yes
	CAIN	C,2		;is this the PMS digest (story 002)?
	JRST	DIGEST		;yes
	CAIN	C,=201		;is this the story just before the AMS digest?
	JRST	DONTDO		;yes
	CAIN	C,=202		;is this the AMS digest (story 202)?
	JRST	DIGEST		;yes
;For each word in story, collect its letters.

	MOVEI	A,=35		;number of words at the front of the story that
	MOVEM	A,WRDCNT	;	are checked for special meanings
	SETZM	SORDID		;zero the header for the sorted list
	MOVEI	0,100		;load 100 for storing bytes containing @'s
BETW:	AOSLE	CHCNT		;begin reading characters until a letter is hit or
	JRST	READ		;	there are no more characters
	ILDB	CHAR,BPTR	;get next character from story
	CAIL	CHAR,"A"
	JRST	LTR
	CAIL	CHAR,"0"	;character is not a letter
	CAILE	CHAR,"9"	;is it a digit?
	JRST	BETW		;no
	JRST	CONT		;yes
LTR2:	TRZ	CHAR,40		;make all letters upper case
	JRST	MIDDL
LTR:	TRZ	CHAR,40		;make all letters upper case
CONT:	MOVEM	TXTPTR,SORDID(SORPTR);store byte ptr to TEXT of this new word
MIDDL:	IDPB	CHAR,TXTPTR	;deposit this letter in TEXT
	AOSLE	CHCNT		;any more chars in story?
	JRST	DEP100		;no
	ILDB	CHAR,BPTR	;yes, get one
	CAIL	CHAR,"A"
	JRST	LTR2		;it's a letter
	CAIGE	CHAR,"0"	;it's not a letter
	JRST	DEP100		;nor a digit
	CAIG	CHAR,"9"
	JRST	MIDDL		;it is a digit and the word goes on
DEP100:	IDPB	0,TXTPTR	;end of word...fill out text word with @'s
	TLNE	TXTPTR,760000
	JRST	DEP100
	HRRZ	A,SORDID(SORPTR);get ptr to beginning of current word
	MOVE	PART1,1(A)	;move word to PARTS for comparison for sorting
	MOVE	PART2,2(A)
	MOVE	PART3,3(A)
	MOVE	PART4,4(A)
;Check current word for indicator of a correction, an add, or a take.

	SOSGE	WRDCNT			;is current word among first 20 words of story?
	JRST	ON			;no
	CAMN	PART1,[ASCII /TAKES/]	;is story the first of several takes?
	JRST	[SETOM	TAKEFG		;yes.  mark it so
		 JRST ON]
	CAMN	PART1,[ASCII /TAKE@/]	;is story possibly a take of an earlier story?
	JRST	TAKE			;yes
	TDNE	PART1,[372010040000]	;is current word possibly a seq nbr?
	JRST	ON			;no
	SETCA	PART1,			;yes
	TDNE	PART1,[405406030000]	;check appropriate bits for 1's
	JRST	GOON			;not a seq nbr
	SETCA	PART1,
;is a seq nbr.
	LDB	B,[POINT 7,PART1,13]	;AC B WILL HOLD THE REFERENCED SEQ NBR IN BINARY
	SUBI	B,60			;CONVERT 1ST DIGIT TO BINARY FROM ASCII
	IMULI	B,=10
	LDB	C,[POINT 7,PART1,20]
	ADDI	B,-60(C)		;ADD IN 2ND DIGIT OF SEQ NBR
	IMULI	B,=10
	LDB	C,[POINT 7,PART1,27]
	ADDI	B,-60(C)		;ADD IN 3RD DIGIT OF SEQ NBR

	MOVE	PREV,UNDUN		;prepare to look up index entry for prev story
	MOVEI	A,=200			;max nbr of stories back we are willing to look
NXPREV:	SOJL	A,ON			;have we check max nbr of stories already?
	SUBI	PREV,XSIZE		;no.  get index of the previous story
	CAIGE	PREV,SPECS
	MOVEI	PREV,XLEN-XSIZE
	HRRZ	C,INDEX+2(PREV)		;GET SEQ NBR OF THIS PREVIOUS STORY
	CAME	B,C			;IS THE PREV STORY THE ONE REFERRED TO?
	JRST	NXPREV			;no
LINKEM:	OPEN	7,DSK17			;grab INDEX file
	ERRXIT	{OPEN FAILED ON DSK (10)}
	SETZM	INDEXF+1
	SETZM	INDEXF+2
	SETZM	INDEXF+3
	ENTER	7,INDEXF
	JRST	[RELEAS 7,
		 MOVEI	A,2
		 CALL	A,[SIXBIT /SLEEP/]
		 JRST	LINKEM]
	JRST	FINISH
GOON:	SETCA	PART1,			;re-complement PART1 back to normal
	JRST	ON			;	and go on
TAKE:	MOVEM	BPTR,SPBPTR		;copy the (byte) ptr into the story
TAK1:	ILDB	CHAR,SPBPTR		;get next char from story
	CAIN	CHAR,"t"		;is it a "t" (as in "two")?
	JRST	TAK9
	CAIL	CHAR,"A"		;is it a letter?
	JRST	ON
	CAIL	CHAR,"0"		;no.
	CAILE	CHAR,"9"		;is it a digit?
	JRST	TAK1			;no.  get next char
TAK9:	MOVE	PREV,UNDUN		;yes.  we have, eg: take 2
	SETOM	TAKEFG			;set take flag in case cant find original take
	HRREI	A,-6			;number of stories back we are willing
	MOVEM	A,STCNT			;	to look for the earlier take
	ADD	A,HISEQ
	MOVEM	A,LOSEQ			;SAVE MIN SEQ NBR WE CAN ACCEPT FOR EARLIER TAKE
TAK8:	SUBI	PREV,XSIZE		;get index of the previous story
	CAIGE	PREV,SPECS		;	so that we can link current
	MOVEI	PREV,XLEN-XSIZE		;	story with the previous one,
	HRRZ	A,INDEX+2(PREV)		;	which should be an earlier
	CAML	A,LOSEQ			;	take of the same story.
	CAMLE	A,HISEQ			;IS SEQ NBR OF THIS PREV STORY IN RIGHT RANGE?
	JRST	GETNXT			;NO.  GET NEXT PREV STORY.
	HRRE	C,INDEX(PREV)		;YES.  IS THIS PREV STORY A TAKE?
	AOJE	C,LINKEM		;IF SO, LINK IT UP TO THE CURRENT STORY
GETNXT:	AOSGE	STCNT			;HAVE WE EXAMINED LIMIT OF PREV STORIES?
	JRST	TAK8			;NO.  TRY THE NEXT PREV STORY.
;Find appropriate place in sorted list for current word.

ON:	MOVE	A,SORDID(SORPTR);retrieve byte ptr into TEXT for current word
	SUB	A,TXTPTR	;get length of word
	HRLM	A,SORDID(SORPTR);save length of this word
	CAMGE	A,[-4]		;is word longer than 20 letters?
	HRREI	A,-4		;yes.  ignore all but first 20 letters
	MOVEM	A,LEN		;save pseudo length of this word (max = 4)
	SETZ	LWD,		;LWD points to the last examined word in the list
NEXT:	HLRZ	WD,SORDID(LWD)	;get pointer from LWD to next WD
	TRZ	WD,700000	;zero out length bits that were in the pointer
	JUMPE	WD,INSERT	;if null pointer, insert word at end of list
	HRRZ	FIRST,SORDID(WD);get pointer from WD to text (characters) of word
	MOVE	A,LEN		;load A with length of current word (in words)
	CAME	PART1,1(FIRST)	;method of comparison: compare first parts.
	JRST	CHECK1		;	If unequal, jump out. Otherwise, if
	AOJGE	A,INSERT	; 	there is still part of the word left,
	CAME	PART2,2(FIRST)	;	continue comparing.If the word is the
	JRST	CHECK2		;	same as an existing word, go to INSERT to
	AOJGE	A,INSERT	;	insert it again.
	CAME	PART3,3(FIRST)
	JRST	CHECK3
	AOJGE	A,INSERT
CHECK4:	CAMG	PART4,4(FIRST)	;note that we only need one CAM for the last part (PART4)
	JRST	INSERT
	JRST	ADVNCE
CHECK3:	CAMG	PART3,3(FIRST)	;if it is greater, then you want to continue checking.
	JRST	INSERT		;if it is less, you want to insert it where you are
	JRST	ADVNCE		;advance the pointers.
CHECK2:	CAMG	PART2,2(FIRST)
	JRST	INSERT
	JRST	ADVNCE
CHECK1:	CAMG	PART1,1(FIRST)
	JRST	INSERT
ADVNCE:	MOVE	LWD,WD		;the new LWD is the old WD
	JRST	NEXT		;continue down list looking for place to insert current word

;insert next word into list of previously sorted words.

INSERT:	HLRZ	A,SORDID(SORPTR);retrieve the size of current word
	ASH	A,17		;move the size to the left hand bits of AC right
	ADD	A,WD		;put the link in the low order bits of AC right
	HRLM	A,SORDID(SORPTR);store the length and link of the new word
	HLRZ	A,SORDID(LWD)	;get the length and link of LWD
	TRZ	A,77777		;zero the link
	ADD	A,SORPTR	;add in the new link
	HRLM	A,SORDID(LWD)	;store the length and new link of LWD
	ADDI	SORPTR,1	;increment SORPTR to next word not yet sorted
	JRST	BETW
;Open INDEX and DICT files.  Read in WORDS and LINKS files.

READ:	OPEN	7,DSK17		;prepare to open INDEX for writing new version
	ERRXIT	{OPEN FAILED ON DSK (12)}
	SETZM	INDEXF+1
	SETZM	INDEXF+2
	SETZM	INDEXF+3
	ENTER	7,INDEXF	;INDEX file
	JRST	PAUSE2		;FILER must be writing INDEX now...wait a bit

AGAIN4:	OPEN	3,DSK17		;open DICT file in Read Alter mode
	ERRXIT	{OPEN FAILED ON DSK (14)}
	SETZM	DICTF+3
	LOOKUP	3,DICTF
	JRST	PAUSE4
	SETZM	DICTF+1
	SETZM	DICTF+2
	SETZM	DICTF+3
	ENTER	3,DICTF
	JRST	PAUSE4
	SETZM	DICREC		;indicate that no DICT rec is in core
	SETZM	MLTREC		;indicate that no mult rec of DICT is in core
	SETOM	CATNBR
	PUSHJ	P,GTDICT

	OPEN	4,DSK17		;read in WORDS
	ERRXIT	{OPEN FAILED ON DSK (16)}
	SETZM	WORDSF+3
	LOOKUP	4,WORDSF
	ERRXIT	{LOOKUP FAILED ON FILE: WORDS (18)}
	IN	4,WCMD
	JRST	.+2
	ERRXIT	{IN UUO FAILED DURING ATTEMPT TO READ IN FILE: WORDS (20)}
	RELEAS	4,

	OPEN	5,DSK17		;read in LINKS
	ERRXIT	{OPEN FAILED ON DSK (22)}
	SETZM	LINKSF+3
	LOOKUP	5,LINKSF
	ERRXIT	{LOOKUP FAILED ON FILE: LINKS (24)}
	IN	5,LCMD
	JRST	.+2
	ERRXIT	{IN UUO FAILED DURING ATTEMPT TO READ IN FILE: LINKS (26)}
	RELEAS	5,
;Look for keywords in story.  Link up any that are found.

	SETZM	LINKS+1			;init back ptr from new story to LINKS
	SETZ	WD,			;point to header of sorted list
	MOVEI	DICTWD,2		;point to first word in dictionary
	MOVEM	DICTWD,DICPTR
NEXTWD:	SETZM	CATFLG			;clear the "categorized" flag
	HLRZ	WD,SORDID(WD)		;get link to next word in list
	TRZ	WD,700000		;zero out the length field
	JUMPE	WD,DONE			;a zero link means end of list
	HLRO	A,SORDID(WD)		;get length this word
	ASH	A,-17			;right adjust the length
	HRRZ	TXTPTR,SORDID(WD)	;get the pointer to the text of this word
	MOVE	PART1,1(TXTPTR)
	MOVE	PART2,2(TXTPTR)
	MOVE	PART3,3(TXTPTR)		;load the parts of this word into ACs
	MOVE	PART4,4(TXTPTR)
	SUB	TXTPTR,A		;advance TXTPTR to next consecutive word in TEXT
	CAMGE	A,[-4]
	HRREI	A,-4			;prepare to compare at most 4 parts of current word
	MOVEM	A,LEN			;save pseudo length of this word
	JRST	.+2

NXTDWD:	PUSHJ	P,RDDICT
	HLRZ	FIRST,DICT(DICTWD)	;get pointer to text of dictionary word
	MOVE	A,LEN			;put length of current word into A
	CAME	PART1,WORDS(FIRST)	;compare parts until inequality or
	JRST	CK1			;	until no more parts left in
	AOJGE	A,EQUAL			;	which case words must be equal
	CAME	PART2,WORDS+1(FIRST)
	JRST	CK2
	AOJGE	A,EQUAL
	CAME	PART3,WORDS+2(FIRST)
	JRST	CK3
	AOJGE	A,EQUAL
	CAMN	PART4,WORDS+3(FIRST)
	JRST	EQUAL

CK4:	CAMG	PART4,WORDS+3(FIRST)	;when a part is unequal, see which word is less
	JRST	NEXTWD			;Word not in dictionary
	JRST	NXTDWD			;Get next dictionary word
CK3:	CAMG	PART3,WORDS+2(FIRST)
	JRST	NEXTWD
	JRST	NXTDWD
CK2:	CAMG	PART2,WORDS+1(FIRST)
	JRST	NEXTWD
	JRST	NXTDWD
CK1:	CAMG	PART1,WORDS(FIRST)
	JRST	NEXTWD
	JRST	NXTDWD
;Link up keyword in story.

EQUAL:	HLRZ	A,DICT+1(DICTWD)	;is current dict word part of a mult key?
	JUMPE	A,CATEG			;no.  categorize current story by dict wd
	PUSH	P,MLTREC		;save record nbr of current mult key
	PUSH	P,MLTPTR
	PUSH	P,DICTWD		;save current dict word
	MOVE	DICTWD,A		;get ptr to next word in multiple key
	ADDI	WD,1			;move ptr to following word in story
	MOVE	PART1,1(TXTPTR)		;load the parts of the story word into ACs
	MOVE	PART2,2(TXTPTR)
	MOVE	PART3,3(TXTPTR)
	MOVE	PART4,4(TXTPTR)
	HLRO	A,SORDID(WD)		;get length of this story word
	ASH	A,-17			;shift length into low order bits of AC
	SUB	TXTPTR,A		;move TXTPTR to the NEXT story word
	CAMGE	A,[-4]			;compare at most 4 parts of the story
	HRREI	A,-4			;	word and the dict word
	MOVEM	A,LEN			;save pseudo length of story word
BRO:	PUSHJ	P,GETMLT		;make sure the DICT rec containing the mult is in core
	MOVE	A,LEN			;put length of story word in AC A for counting
	HLRZ	FIRST,DICT(DICTWD)	;get ptr to first part of dict wd in WORDS
	CAME	PART1,WORDS(FIRST)	;compare story word and dict word
	JRST	NOTSAM
	AOJGE	A,EQUAL			;A=0 means we are at end of story word
	CAME	PART2,WORDS+1(FIRST)
	JRST	NOTSAM
	AOJGE	A,EQUAL
	CAME	PART3,WORDS+2(FIRST)
	JRST	NOTSAM
	AOJGE	A,EQUAL
	CAMN	PART4,WORDS+2(FIRST)
	JRST	EQUAL
NOTSAM:	HRRZ	DICTWD,DICT+2(DICTWD)	;story word not same as dict wd. get ptr to
	JUMPN	DICTWD,BRO		;  mult bro. if zero, then no bro exists.
	JRST	EQ2

;categorize story by longest keyword that matched.
CATEG:	SKIPN	AVAIL,LINKS		;any slots available in LINKS file?
	JRST	EQ2			;no!!
	CAIL	DICTWD,200
	PUSHJ	P,[MOVE	A,GUDREC	;make sure correct mult rec is in core
		   JRST	CHKREC]
	HRRE	A,DICT+1(DICTWD)	;get pointer to first slot for current word
	JUMPL	A,EQ2			;is this a legal keyword?
	SKIPGE	B,CATNBR
	JRST	EQ4
	CAMN	DICTWD,KEYS(B)		;has this keyword already categorized story?
	JRST	EQ2			;yes
	SOJGE	B,.-2
EQ4:	AOS	B,CATNBR		;prepare to save ptr to keyword entry in
	CAIL	B,NKEYS			;	KEYS array to prevent duplication
	JRST	EQ2			;no more room in KEYS array. dont use keyword
	MOVEM	DICTWD,KEYS(B)		;insure that this keyword won't be used again
	SETOM	CATFLG			;yes.  set "categorized" flag
	SETOM	WRFLAG			;mark current DICT rec as changed
	MOVE	B,LINKS(AVAIL)		;remove available slot from free slot list
	MOVEM	B,LINKS			;	and update free-slot list header
	JUMPE	A,EQ1			;a zero pointer means no such slot exists
	HRRM	AVAIL,LINKS(A)		;store back ptr to new slot in old slot
	HRLM	A,LINKS(AVAIL)		;store ptr to old slot in new slot
EQ1:	CAIL	DICTWD,200		;is this a mult word key?
	SKIPA	A,MLTPTR		;yes. get negated ptr to mult word key
	MOVN	A,DICPTR		;no. negate dictwd pointer for storing it
	HRRM	A,LINKS(AVAIL)		;store negated dict pointer in new slot
	HRRM	AVAIL,DICT+1(DICTWD)	;store ptr to new slot in dict entry for current word
	MOVE	A,LINKS+1		;get back ptr to last slot in current story
	MOVEM	A,LINKS+1(AVAIL)	;store that ptr in new slot
	MOVE	B,UNDUN			;load ptr to current story
	HRRM	B,LINKS+1(AVAIL)	;store ptr to current story in new slot
	HRLZM	AVAIL,LINKS+1		;update back ptr to last slot for story (new slot)
EQ2:	CAMN	P,INITPD		;have all multiple word entries been popped?
	JRST	NEXTWD			;yes
	POP	P,DICTWD		;no. pop next one off stack
	SUBI	WD,1			;	and readjust ptr to word in story
	POP	P,MLTPTR
	POP	P,GUDREC		;retrieve mult rec nbr for this mult key
	SKIPE	CATFLG			;has the current keyword been categorized?
	JRST	EQ2			;yes. just pop rest of mult word entries.
	JRST	CATEG			;no. try to categorize it now.
;Write out new versions of files.

DONE:	USETO	3,@DICREC	;select the appropriate record for writing out dict
	SKIPE	WRFLAG		;has the record of DICT that is in core been changed?
	OUT	3,DCMD		;yes.  write out the new values.
	JRST	.+2
	ERRXIT	{OUT UUO FAILED TO WRITE OUT RECORD OF DICT (27)}
	SKIPN	MLTREC		;is there a mult rec of DICT in core?
	JRST	DUN2		;no
	USETO	3,@MLTREC	;yes.  select correct rec for writing it out
	OUT	3,MCMD		;write out last mult rec that is in core
	JRST	.+2
	ERRXIT	{OUT UUO FAILED TO WRITE OUT LAST MULT REC OF DICT (27.5)}
DUN2:	OPEN	10,DSK17	;prepare to write out LINKS
	ERRXIT	{OPEN FAILED ON DSK (28)}
	SETZM	LINKSF+1
	SETZM	LINKSF+2
	SETZM	LINKSF+3
	ENTER	10,LINKSF
	ERRXIT	{ENTER FAILED ON FILE: LINKS (30)}
	OUT	10,LCMD		;write out LINKS file
	JRST	.+2
	ERRXIT	{OUT UUO FAILED DURING ATTEMPT TO WRITE OUT FILE: LINKS (32)}
FINISH:	MOVE	B,UNDUN		;get ptr to current (UNDUN story)
	OPEN	6,DSK17		;prepare to open INDEX for reading old version
	ERRXIT	{OPEN FAILED ON DSK (34)}
	SETZM	INDEXF+3
	LOOKUP	6,INDEXF	;INDEX file
	ERRXIT	{LOOKUP FAILED ON FILE: INDEX (36)}
	IN	6,XCMD		;read in entire INDEX file
	JRST	.+2
	ERRXIT	{IN UUO FAILED DURING ATTEMPT TO READ IN FILE: INDEX (38)}
	RELEAS	6,		;old version of INDEX that was just read
	SKIPE	MISSIN		;should new parameters be written out for this story?
	JRST	FIN3		;no
	MOVE	A,LINKS+1	;load back ptr to last slot for current story
	HLLM	A,INDEX(B)	;store this back ptr in index info for this story
	MOVE	A,TAKEFG
	HRRM	A,INDEX(B)	;put first-take flag into index for this story
	JUMPE	PREV,FIN3	;ACs WD and PREV are the same. so if the current
FIN1:	HRRE	A,INDEX(PREV)	;	story is to be linked up with an earlier
	JUMPLE	A,FIN2		;	one, PREV will be non-zero. if the current
	MOVE	PREV,A		;	story is not to be linked up with an
	JRST	FIN1		;	earlier story WD (PREV) will be zero
FIN2:	HRRM	A,INDEX(B)	;put whatever was in the old story's link in the new story's
	HRRM	B,INDEX(PREV)	;put a link to the new story in the old story's link
FIN3:	ADDI	B,XSIZE		;advance UNDUN
	CAIL	B,XLEN
	MOVEI	B,SPECS
	MOVEM	B,UNDUN		;put new value of UNDUN back into INDEX array
	OUT	7,XCMD		;write out new INDEX file
	JRST	.+2
	ERRXIT	{OUT UUO FAILED DURING ATTEMPT TO WRITE OUT FILE: INDEX (40)}
	RELEAS	10,		;LINKS file
	RELEAS	3,		;DICT file
	RELEAS	7,		;new version of INDEX file
	SKIPE	MISSIN		;check if the story to have been catagorized was missing
	ERRXIT	{A STORY SEEMINGLY DISAPPEARED BEFORE BEING CATAGORIZED (41)}
;	OUTSTR	[ASCIZ / FINISHED! /]
	SKIPE	LINKS		;have we run out of slots in LINKS?
	JRST	MORE		;no
	JUMPN	PREV,MORE	;prev ≠ 0 means LINKS wasn't read in, so we are ok
	ERRXIT	{NO AVAILABLE SLOTS IN LINKS (42)};LINKS was read in and there are no more slots
;Subroutines:  RDDICT, GTDICT, PAUSE1-4, DIGEST, DONTDO, GONE.

RDDICT:	SETOM	CATNBR		;indicate no similar keywords used
	MOVEI	A,2		;advance to next entry in dictionary by incrementing
	ADDM	A,DICPTR	;	DICPTR and DICTWD by 2
	ADDI	DICTWD,2
	CAIGE	DICTWD,200	;has DICTWD gone beyond the record that is in core?
	POPJ	P,		;no.  return.
	SKIPN	WRFLAG		;has the DICT record in core been changed?
	JRST	GTDICT		;no
	USETO	3,@DICREC	;yes. select correct record for writing it out
	OUT	3,DCMD		;write out the new values.
	JRST	.+2
	ERRXIT	{OUT UUO FAILED WHEN WRITING OUT ONE RECORD OF DICT (43)}
GTDICT:	AOS	A,DICREC	;adjust DICREC to the new record number
	USETI	3,(A)
	IN	3,DCMD		;read in the next record
	JRST	.+2
	ERRXIT	{IN UUO FAILED DURING ATTEMPT TO READ IN A RECORD OF THE FILE: DICT (44)}
	SETZM	WRFLAG		;reset the write flag
	SETZ	DICTWD,		;set DICTWD to point at beginning of record
	POPJ	P,		;return

;make sure the record needed for a mult DICT entry, as indicated by DICTWD, is in core
GETMLT:	MOVE	A,DICTWD
	MOVNM	DICTWD,MLTPTR	;save negated ptr to this mult word key
	TRZ	DICTWD,777600	;zero out record part of DICTWD
	ADDI	DICTWD,200	;make DICTWD point to the mult rec of DICT in core
	ASH	A,-7		;calculate the number of the mult rec needed in core
	ADDI	A,1
CHKREC:	MOVEM	A,GUDREC
	CAMN	A,MLTREC	;is that record already in core?
	POPJ	P,		;yes
	SKIPN	MLTREC		;is any mult rec in core?
	JRST	GETM		;no
	USETO	3,@MLTREC	;yes. select the proper rec nbr for writing it back out
	OUT	3,MCMD		;write out the rec that is in core
	JRST	.+2
	ERRXIT	{OUT UUO FAILED TO WRITE OUT MULT REC OF DICT (43.7)}
GETM:	MOVEM	A,MLTREC	;save number of new mult rec to be in core
	USETI	3,(A)		;select the correct record to be read in
	IN	3,MCMD		;read in a new mult rec
	POPJ	P,		;return
	ERRXIT	{IN UUO FAILED TO READ IN MULT REC FROM DICT (43.9)}

PAUSE1:	RELEAS	0,
;	OUTSTR	[ASCIZ / PAUSE-NEWS /]
	MOVEI	A,2
	CALL	A,[SIXBIT /SLEEP/]
	JRST	AGAIN1
PAUSE2:	RELEAS	7,
;	OUTSTR	[ASCIZ / PAUSE-INDEX /]
	MOVEI	A,2
	CALL	A,[SIXBIT /SLEEP/]
	JRST	READ
PAUSE3:	RELEAS	1,
	MOVEI	A,1
	CALL	A,[SIXBIT /SLEEP/]
	JRST	AGAIN3
PAUSE4:	RELEAS	3,
	MOVEI	A,2
	CALL	A,[SIXBIT /SLEEP/]
	JRST	AGAIN4

;and now, a few kludges...
DONTDO:
DIGEST:	SETZ	PREV,		;inhibit linking this story with any earlier story
	SETOM	LINKS		;inhibit error msg about no slots in LINKS
	SETZM	LINKS+1		;clear back ptr to LINKS slots for this story
	JRST	LINKEM		;finish up

GONE:	SETOM	LINKS		;inhibit error msg about no slot in LINKS
	SETOM	MISSIN		;set flag indicating that this story was not found
	JRST	LINKEM		;finish up
;Subroutines: ERROR.

ERROR:	SETOM	TTYLIN
	GETLIN	TTYLIN
	AOSN	TTYLIN
	JRST	ADDERR
	OUTSTR	[CRLFS:	ASCIZ /

/]
	OUTSTR	(A)		;job not detached so print out message
	OUTSTR	CRLFS
	MOVE	A,SAVEDA
	CALLI	1,12		;EXIT, inhibit file closing
	HALT	.

ADDERR:	CALLI	0		;RESET
	MOVEI	B,1
	MOVEI	C,10
AGAINE:	INIT	1,0
	SIXBIT	/DSK/
	XWD	ERRBFO,0
	HALT	.-3
	SETZM	ERRORF+1
	SETZM	ERRORF+2
	SETZM	ERRORF+3
	ENTER	1,ERRORF
	JRST	[RELEAS	1,
		 SOJLE	C,SPLIT
		 CALL	B,[SIXBIT /SLEEP/]
		 JRST	AGAINE]
	INIT	2,0
	SIXBIT	/DSK/
	ERRBFI
	HALT	.-3
	SETZM	ERRORF+3
	LOOKUP	2,ERRORF
	JRST	COPIED
COPYER:	SOSG	ERRBFI+2
	IN	2,
	JRST	[ILDB	CHAR,ERRBFI+1
		 JUMPE	CHAR,COPIED
		 SOSG	ERRBFO+2
		 OUT	1,
		 JRST	[IDPB	CHAR,ERRBFO+1
			 JRST	COPYER]
		 FOO: HALT FOO]
	STATO	2,20000
	HALT	.
COPIED:	RELEAS	2,
	CALL	B,[SIXBIT /DATE/]
	CALL	C,[SIXBIT /TIMER/]
;Write error message on a file with the time, month, and day.

	IDIVI	C,=60*=3600
	IDIVI	C+1,=3600
	IDIVI	C+1,=10
	HRLZI	AC1,40B24		;put a blank in AC1
	ADDI	AC1,60(C+2)		;ONES PLACE OF MINUTES
	ROT	AC1,-7
	ADDI	AC1,60(C+1)		;TENS PLACE OF MINUTES
	ROT	AC1,-7
	IDIVI	C,=10
	ADDI	AC1,60(C+1)		;ONES PLACE OF HOURS
	ROT	AC1,-7
	ADDI	AC1,60(C)		;TENS PLACE OF HOURS
	ROT	AC1,-7
	IDIVI	B,=31
	ADDI	B+1,1
	IDIVI	B+1,=10
	MOVEI	AC2,60(B+2)		;ONES PLACE OF DAY
	ROT	AC2,-7
	ADDI	AC2,60(B+1)		;TENS PLACE OF DAY
	ROT	AC2,-16
	ADD	AC2,[ASCII /-/]		;PUT "-" BETWEEN MONTH AND DAY
	IDIVI	B,=12
	ADDI	B+1,1
	IDIVI	B+1,=10
	ADDI	AC2,60(B+2)		;ONES PLACE OF MONTH
	ROT	AC2,-7
	ADDI	AC2,60(B+1)		;TENS PLACE OF MONTH
	ROT	AC2,-7
	MOVE	BPTR,[POINT 7,AC1]
	MOVEI	C,=10			;put 10 chars into output buffer
DAYTIM:	ILDB	CHAR,BPTR		;output the time, month, and day
	SOSG	ERRBFO+2
	OUT	1,
	JRST	[IDPB	CHAR,ERRBFO+1
		 SOJG	C,DAYTIM
		 JRST	ADDMSG]
	HALT	.
ADDMSG:	HRLI	A,440700		;output error message
MESSAG:	ILDB	CHAR,A
	SOSG	ERRBFO+2
	OUT	1,
	JRST	[IDPB	CHAR,ERRBFO+1
		 JUMPN	CHAR,MESSAG
		 JRST	CLOSEM]
	HALT	.
CLOSEM:	RELEAS	1,
SPLIT:	SKIPE	XITFLG		;should DOER exit now?
	CALL	[SIXBIT /EXIT/]	;yes
	MOVEI	A,SWAPBK	;no
	CALL	A,[SIXBIT /SWAP/];get a new version of DOER started up
;Interrupt level module: INTRPT, CHGNAM.

INTRPT:	MOVE	A,JOBCNI
	JFFO	A,.+1
	CAIN	A+1,=19			;was it an interrupt to set the job name
	JRST	CHGNAM			;yes.  do it.
	MOVEM	A+1,SVINTR#		;save indicator of the cause of interrupt
	CALL	[SIXBIT /UWAIT/]
	JRST@	2,[.+1]			;no.  get out of user-iot.
	CALL	[SIXBIT /DEBREAK/]
	MOVE	A,SVINTR
	CAIE	A,=9			;was the interrupt for a parity error?
	ERRXIT	{UNKNOWN INTERRUPT OCCURRED IN DOER}	;no!
	ERRMSG	{PARITY ERROR IN DOER}			;yes

CHGNAM:	SETZ	A,			;zero out job name
	CALL	A,[SIXBIT /SETNAM/]
	SETOM	NRDOER			;initialize indicator to one other doer
	MOVE	A,NAME
	CALL	A,[SIXBIT /NAMEIN/]
	JRST	.+2			;zero or multiple doers exist
	CALL	[SIXBIT /DISMIS/]	;exactly one other doer exists
	SETZM	NRDOER			;set indicator to multiple doers
	CAIE	A,1			;check error code of NAMEIN
	CALL	[SIXBIT /DISMIS/]	;multiple doers exist
	AOS	NRDOER			;set indicator to no other doers
	MOVE	A,NAME			;set job name
	CALL	A,[SIXBIT /SETNAM/]
	MOVEI	A,200000
	CALL	A,[SIXBIT /INTACM/]	;disable further pdl ov interrupts
	CALL	[SIXBIT /DISMIS/]

	END	DOER